home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2005 June / PCpro_2005_06.ISO / files / opensource / amc / amc_install.exe / {app} / Scripts / FilmOnet (PL).ifs < prev    next >
Encoding:
Text File  |  2005-02-14  |  11.7 KB  |  400 lines
  1. (***************************************************
  2.  
  3. Ant Movie Catalog importation script
  4. www.antp.be/software/moviecatalog/
  5.  
  6. [Infos]
  7. Authors=based on Filmweb.pl version (c) 2002 Piotr Kardasz
  8. Title=Onet (PL)
  9. Description=Movie importation script for Onet import, made by Cabal & Mirwoj
  10. Site=www.film.wp.pl
  11. Language=PL
  12. Version=1.0
  13. Requires=3.5.0
  14. Comments=Film.Onet.pl movie information importation script Works fine, but return nothing when movie does not exists on film.onet.pl Script does not affect original movie title [in order not to change it when wrong movie found, but it can be changed - just uncomment one line]|14.02.2005 Improvements made by Adma's
  15. License=This program is free software; you can redistribute it and/or modify it under the  terms of the GNU General Public License as published by the Free Software Foundation;  either version 2 of the License, or (at your option) any later version. |
  16. GetInfo=1
  17.  
  18. [Options]
  19.  
  20. ***************************************************)
  21.  
  22. program Onet;
  23. var
  24.   MovieName: string;
  25.  
  26. procedure DelSpace(var Value: String);
  27. var
  28.   FullValue: String;
  29.   Counter: Integer;
  30. begin
  31.   if Value <> '' then
  32.   begin
  33.     FullValue := FullValue + StrGet(Value, 1);
  34.     for Counter := 2 to Length(Value) do
  35.     begin
  36.       if StrGet(Value, Counter) <> ' ' then
  37.         FullValue := FullValue + StrGet(Value, Counter)
  38.       else
  39.         if StrGet(FullValue, Length(FullValue)) <> ' ' then
  40.           FullValue := FullValue + ' ';
  41.     end;
  42.     Value := FullValue;
  43.   end
  44. end;
  45.  
  46. procedure DecodeHTML(var Value: String);
  47. var
  48.   FullValue, CharCode: String;
  49.   Counter: Integer;
  50. begin
  51.   if Value <> '' then
  52.   begin
  53.     FullValue := '';
  54.     Counter := 1;
  55.     repeat
  56.       if StrGet(Value, Counter) <> '&' then
  57.         begin
  58.           CharCode := copy(Value, Counter, 1);
  59.           case CharCode of
  60.             '▒': CharCode := '╣';
  61.             '╢': CharCode := '£';
  62.             '╝': CharCode := 'ƒ';
  63.             'ª': CharCode := 'î';
  64.             'í': CharCode := 'Ñ';
  65.             '¼': CharCode := 'Å';
  66.           end;
  67.           FullValue := FullValue + CharCode;
  68.           Counter := Counter + 1;
  69.         end
  70.       else
  71.         begin
  72.           CharCode := copy(Value, Counter, 7);
  73.           case CharCode of
  74.             'ą': FullValue := FullValue + '╣';
  75.             'ć': FullValue := FullValue + 'µ';
  76.             'ę': FullValue := FullValue + 'Ω';
  77.             'ł': FullValue := FullValue + '│';
  78.             'ń': FullValue := FullValue + '±';
  79.             'ó': FullValue := FullValue + '≤';
  80.             'ś': FullValue := FullValue + '£';
  81.             'ź': FullValue := FullValue + 'ƒ';
  82.             'ż': FullValue := FullValue + '┐';
  83.             'Ą': FullValue := FullValue + 'Ñ';
  84.             'Ć': FullValue := FullValue + '╞';
  85.             'Ę': FullValue := FullValue + '╩';
  86.             'Ł': FullValue := FullValue + 'ú';
  87.             'Ń': FullValue := FullValue + '╤';
  88.             'Ó': FullValue := FullValue + '╙';
  89.             'Ś': FullValue := FullValue + 'î';
  90.             'Ź': FullValue := FullValue + 'Å';
  91.             'Ż': FullValue := FullValue + '»';   
  92.           else
  93.             FullValue := FullValue + CharCode;  
  94.           end;
  95.           Counter := Counter + 7;
  96.         end;
  97.     until Counter > Length(Value);
  98.     HTMLDecode(FullValue);
  99.     Value := FullValue;
  100.   end
  101. end;
  102.  
  103. procedure StripHTML(var sString: string);
  104. var i:integer;
  105.     sTemp: string;
  106.     bOutHTML: boolean;
  107.     cChar: char;
  108. begin
  109.   sTemp := sString;
  110.   sString := '';
  111.   bOutHTML := TRUE;
  112.     
  113.   for i :=1 to Length(sTemp) do
  114.   begin
  115.     cChar := Copy(sTemp,i,1);
  116.     if (cChar = '<') then bOutHTML := FALSE;
  117.     if (bOutHTML) then
  118.     sString := sString + cCHar;
  119.     if (cChar = '>') then bOutHTML := TRUE;
  120.   end;
  121. end;
  122.  
  123. function CountStrings(sString: String; sWhat: String): Integer;
  124. var
  125.   iCnt: Integer;
  126.   iPos: Integer;
  127. begin
  128.   iCnt := 0;
  129.   iPos := Pos(sWhat, sString);
  130.   while iPos > 0 do
  131.   begin
  132.     iCnt := iCnt + 1;
  133.     sString := Copy(sString, iPos + 1, Length(sString));
  134.     iPos := Pos(sWhat, sString);
  135.   end;
  136.   Result := iCnt;
  137. end;
  138.  
  139. function RetrieveMovieTitle(sTitleBff: String): String;
  140. var
  141.   iEndPos: Integer;
  142. begin
  143.   iEndPos := Pos('</B>', sTitleBff);
  144.   if iEndPos > 0 then
  145.     Result := Copy(sTitleBff, 1, iEndPos - 1)
  146.   else
  147.     Result := '???';
  148.  
  149.   DecodeHTML(Result);
  150.   HTMLRemoveTags(Result);
  151. end;
  152.  
  153. function AddMoviesTitles(Page: TStringList; iCnt: Integer): Integer;
  154. var
  155.   MovieTitle: string;
  156.   i, iPos: Integer;
  157.   cChar: Char;
  158.   iNumLen: Integer;
  159.   sNum: String;
  160.   sPage: String;
  161.   oPage: TStringList;
  162.  
  163. begin
  164.     sPage := Page.Text;
  165.  
  166.     if (iCnt = 1) then
  167.     begin
  168.       iPos := Pos(',film.html" class=', sPage) - 1;
  169.       MovieTitle := RetrieveMovieTitle(Copy(sPage, iPos + 24, 200));
  170.  
  171.       cChar := Copy(sPage, iPos, 1);
  172.       iNumLen := 0;
  173.       while (cChar >= '0') and (cChar <= '9') do
  174.       begin
  175.         iNumLen := iNumLen + 1;
  176.         iPos := iPos - 1;
  177.         cChar := Copy(sPage, iPos, 1);
  178.       end;
  179.       sNum := Copy(sPage, iPos + 1, iNumLen);
  180.       oPage := TStringList.Create;
  181.       oPage.Text := GetPage('http://film.onet.pl/' + sNum +',film.html');
  182.       AnalyzeMoviePage(oPage, 'http://film.onet.pl/' + sNum +',film.html')
  183.     end
  184.     
  185.     else
  186.     
  187.     begin
  188.       PickTreeAdd('Znaleziono filmy:', '');
  189.       for i := 1 to iCnt do
  190.       begin
  191.         iPos := Pos(',film.html" class=', sPage) - 1;
  192.         MovieTitle := RetrieveMovieTitle(Copy(sPage, iPos + 24, 200));
  193.  
  194.         cChar := Copy(sPage, iPos, 1);
  195.         iNumLen := 0;
  196.         while (cChar >= '0') and (cChar <= '9') do
  197.         begin
  198.           iNumLen := iNumLen + 1;
  199.           iPos := iPos - 1;
  200.           cChar := Copy(sPage, iPos, 1);
  201.         end;
  202.         sNum := Copy(sPage, iPos + 1, iNumLen);
  203.       //ShowMessage('URL: http://film.onet.pl/' + sNum +',film.html');
  204.         PickTreeAdd(MovieTitle, 'http://film.onet.pl/' + sNum +',film.html');
  205.  
  206.         sPage := Copy(sPage, iPos + 50, Length(sPage));
  207.       end;
  208.     end;
  209. end;
  210.  
  211. procedure AnalyzePage(Address: string);
  212. var
  213.   Page: TStringList;
  214.   FilmCount, iCnt: Integer;
  215. begin
  216.   Page := TStringList.Create;
  217.   Page.Text := GetPage(Address);
  218.   if pos('Wynik wyszukiwania', Page.Text) = 0 then
  219.     AnalyzeMoviePage(Page, Address)
  220.   else
  221.   begin
  222.     iCnt := CountStrings(Page.Text, ',film.html" class=');
  223.     if(iCnt > 0) then
  224.     begin
  225.     if(iCnt = 1) then AddMoviesTitles(Page, iCnt)
  226.     else
  227.     begin
  228.     PickTreeClear;
  229.     AddMoviesTitles(Page, iCnt);
  230.     if PickTreeExec(Address) then
  231.       AnalyzePage(Address);
  232.     end;
  233.     end;
  234.   end;
  235.   Page.Free;
  236. end;
  237.  
  238. procedure AnalyzeMoviePage(Page: TStringList; sURL: String);
  239. var
  240.   sPage, sValue, sTemp, sPosterURL, sPicUrl: string;
  241.   iPos, iStartPos, iEndPos, iLength: Integer;
  242.   cChar: char;
  243. begin
  244.   sPage := Page.Text;
  245.  
  246.   // Page URL
  247.   SetField(fieldURL, sURL);
  248.  
  249.   // Polish title
  250.   iStartPos := pos('class=tyw', sPage) + 10;
  251.   sPage := Copy(sPage, iStartPos, Length(sPage));
  252.   iEndPos := pos('TD', sPage) - 3;
  253.   sValue := Copy(sPage, 1, iEndPos);
  254.   DecodeHTML(sValue);
  255.   SetField(fieldTranslatedTitle, sValue);
  256.   sPage := Copy(sPage, iEndPos, Length(sPage));
  257.  
  258.   // Oryginal title
  259.   iStartPos := pos('<B>', sPage) + 3;
  260.   iEndPos := pos('</B>', sPage);
  261.   if iStartPos < pos(' (', sPage) then
  262.   begin
  263.   iLength := iEndPos - iStartPos;
  264.   sValue := Copy(sPage, iStartPos, iLength);
  265.   DecodeHTML(sValue);
  266.   //Uncomment this line if you want to save found original title
  267.   //SetField(fieldOriginalTitle, sValue);
  268.   end;
  269.   
  270.   // Country
  271.   iStartPos := pos(' (', sPage) + 2;
  272.   sPage := Copy(sPage, iStartPos, Length(sPage));
  273.   iEndPos := pos(')', sPage) - 7;
  274.   sValue := Copy(sPage, 1, iEndPos);
  275.   DecodeHTML(sValue);
  276.   SetField(fieldCountry, sValue);
  277.   sPage := Copy(sPage, iEndPos, Length(sPage));
  278.  
  279.   // Year of production
  280.   iStartPos := pos(')', sPage) -5;
  281.   sPage := Copy(sPage, iStartPos, Length(sPage));
  282.   iEndPos := pos(')', sPage) - 1;
  283.   sValue := Copy(sPage, 1, iEndPos);
  284.   SetField(fieldYear, sValue);
  285.   sPage := Copy(sPage, iEndPos, Length(sPage));
  286.  
  287.   // Category
  288.   iStartPos := pos('<BR>', sPage) + 4;
  289.   sPage := Copy(sPage, iStartPos, Length(sPage));
  290.   iEndPos := pos('<BR>', sPage) - 1;
  291.   sValue := Copy(sPage, 1, iEndPos);
  292.   DecodeHTML(sValue);
  293.   SetField(fieldCategory, sValue);
  294.   sPage := Copy(sPage, iEndPos, Length(sPage));
  295.   
  296.   // Length
  297.   iStartPos := pos('czas ', sPage) + 5;
  298.   iEndPos := pos('min', sPage) - 1;
  299.   iLength := iEndPos - iStartPos;
  300.   sValue := Copy(sPage, iStartPos, iLength);
  301.   SetField(fieldLength, sValue);
  302.  
  303.   // Director
  304.   iStartPos := pos('yseria', sPage) + 19;
  305.   sPage := Copy(sPage, iStartPos, Length(sPage));
  306.   iEndPos := pos('Scenariusz', sPage) - 5;
  307.   sValue := Copy(sPage, 1, iEndPos);
  308.   StripHTML(sValue);
  309.   DecodeHTML(sValue);
  310.   SetField(fieldDirector, sValue);
  311.   sPage := Copy(sPage, iEndPos, Length(sPage));
  312.  
  313. {
  314.   // Large picture, I'm not sure if this works
  315.   // Uncommeht this section and comment Small picture if you want to download posters
  316.   iStartPos := pos(',plakat.html', sPage);
  317.   if (iStartPos > 0) then
  318.   begin
  319.     sValue := GetField(fieldComments) + '   Znaleznione plakaty: ';
  320.     cChar := Copy(sPage, iStartPos, 1);
  321.     while (cChar <> '"') do
  322.     begin
  323.       iStartPos := iStartPos - 1;
  324.       iLength := iLength + 1;
  325.       cChar := Copy(sPage, iStartPos, 1);
  326.     end;
  327.     iPos := 2;
  328.     sPosterURL :='http://film.onet.pl/' + Copy(sPage, (iStartPos + 1), (iLength-1)) + ',plakat.html';
  329.     sTemp := GetPage(sPosterURL);
  330.     iStartPos := pos('IMG class=pic border=1 src="', sTemp) + 28;
  331.     sTemp := Copy(sTemp, iStartPos, Length(sTemp));;
  332.     iEndPos := pos('"', sTemp) - 1;
  333.     sValue := sValue + 'http://film.onet.pl/' + Copy(sTemp, 1, iEndPos);
  334.     
  335.     
  336.     SetField(fieldComments, sValue);
  337.   end;
  338. }
  339.   // Small picture
  340.   iStartPos := pos('src=', sPage) + 5;
  341.   sTemp := Copy(sPage, iStartPos, Length(sPage));
  342.   iStartPos := pos('src="', sTemp) + 5;
  343.   sTemp := Copy(sTemp, iStartPos, Length(sTemp));
  344.   iEndPos := pos('"', sTemp)-1;
  345.   sPicURL := 'http://film.onet.pl/' + Copy(sTemp, 1, iEndPos);
  346.   GetPicture(sPicURL); // False = do not store picture externally ; store it in the catalog file
  347.  
  348.   // Actors
  349.   iStartPos := pos('Obsada', sPage);
  350.   sTemp := Copy(sPage, iStartPos, Length(sPage));
  351.   iStartPos :=pos('<TABLE', sTemp);
  352.   sTemp := Copy(sTemp, iStartPos, Length(sPage));
  353.   iEndPos := pos('wiΩcej', sTemp) - 5;
  354.   sValue := Copy(sTemp, 1, iEndPos);
  355.   sValue := StringReplace(sValue, '</TR><TR>', ', ');
  356.   StripHTML(sValue);
  357.   DecodeHTML(sValue);
  358.   
  359.   iEndPos := Length(sValue);
  360.   cChar := Copy(sValue, iEndPos, 1);
  361.   while (cChar = ',') or (cChar = ' ') do
  362.   begin
  363.     iEndPos := iEndPos - 1;
  364.     cChar := Copy(sValue, iEndPos, 1);
  365.   end;
  366.   sValue := Copy(sValue, 1, iEndPos);
  367.   SetField(fieldActors, sValue);
  368.  
  369.   // Description
  370.   iStartPos := pos('Tre', sPage);
  371.   if (iStartPos > 0) then
  372.   begin
  373.   iStartPos := iStartPos + 5;
  374.   sTemp := Copy(sPage, iStartPos, Length(sPage));
  375.   iEndPos := pos('</DIV>', sTemp);
  376.   sValue := Copy(sTemp, 1, iEndPos);
  377.   StripHTML(sValue);
  378.   DecodeHTML(sValue);
  379.   SetField(fieldDescription, sValue);
  380.   end
  381.   else SetField(fieldDescription, 'Brak');
  382.  
  383.   //DisplayResults;
  384. end;
  385.  
  386.  
  387. begin
  388.   if CheckVersion(3,5,0) then
  389.   begin
  390.     MovieName := GetField(fieldOriginalTitle);
  391.     if Input('Film.Onet.Pl Import by Cabal & Mirwoj', 'Podaj oryginalny tytu│ filmu:', MovieName) then
  392.     begin
  393.       AnalyzePage('http://film.onet.pl/filmoteka.html?O=1&S='+UrlEncode(MovieName));
  394.     end;
  395.   end
  396.   else ShowMessage('Skrypt wymaga programu Ant Movie Catalog w wersji 3.2.1 lub nowszej');
  397. end.
  398.  
  399.  
  400.